COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (fasload meter)
C00006 ENDMK
C⊗;
(declare (fasload meter)
	 (load "metint.lsp")
	 (setq meter:count-only ()))
(declare 
 (setq local-objects-of-interest '((get "Gets"))))

(DECLARE (MAPEX T))

(meter:meter dderiv
 (meter-funs #.(all-objs)
	     (DEFUN DER1 (A) 
		    (mn "Conses" cons 3)
		    (mn "DER1" der1)
		    (LIST 'QUOTIENT (DERIV A) A)))

 (meter-funs #.(all-objs)
(DEFUN (PLUS DERIV) (A)
       (MN "Plus-deriv" plus-deriv)
       (MN "Conses" cons (+ 1 (length a)))
       (CONS 'PLUS (MAPCAR 'DERIV A))))

 (meter-funs #.(all-objs)
(DEFUN (DIFFERENCE DERIV) (A)
       (MN "Diff-deriv" plus-deriv)
       (MN "Conses" cons (+ 1 (length a)))
       (CONS 'DIFFERENCE (MAPCAR 'DERIV 
				 A))))

 (meter-funs #.(all-objs)
(DEFUN (TIMES DERIV) (A)
       (MN "Times-deriv" plus-deriv)
       (mn "Conses" cons 4)
	(LIST 'TIMES (CONS 'TIMES A)
		(CONS 'PLUS (MAPCAR 'DER1 A)))))

 (meter-funs #.(all-objs)
(DEFUN (QUOTIENT DERIV) (A)
       (MN "Quo-deriv" plus-deriv)
       (mn "Conses" cons 13.)
       (LIST 'DIFFERENCE 
	     (LIST 'QUOTIENT 
		   (DERIV (CAR A)) 
		   (CADR A))
	     (LIST 'QUOTIENT 
		   (CAR A) 
		   (LIST 'TIMES
			 (CADR A)
			 (CADR A)
			 (DERIV (CADR A)))))))

 (meter-funs #.(all-objs)
 (DEFUN DERIV (A)
	(mn "DERIV" deriv)
	(COND 
	 ((ATOM A)
	  (COND ((EQ A 'X) 1) (T 0)))
	 (T (LET ((DERIV (GET (CAR A) 'DERIV)))
		 (mn "Funcalls" funcall)
		 (COND (DERIV (FUNCALL DERIV (CDR A)))
		       (T 'ERROR)))))))

 (meter-funs #.(all-objs)
(DEFUN RUN ()
 (DECLARE (FIXNUM I))
 (DO ((I 0 (1+ I)))
     ((= I 1000.))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))))))